Cream of the Crop 21/Cream of the Crop 21 (Terry Blount) (October 1996).iso/os2/freetype.zip/raster.pas

Pascal/Delphi Source File | 1996-09-07 | 42.8 KB | 1,812 lines

{***************************************************************************}
{*                                                                         *}
{*    The Portable TrueType Engine - Copyright 1996 David TURNER           *}
{*_________________________________________________________________________*}
{*                                                                         *}
{* Unit RASTER.PAS                                                         *}
{*                                                                         *}
{*  This unit is in charge of the final scanlin conversion to a bitmap     *}
{*                                                                         *}
{*  XXX : Cette version est sécurisée et fournit un sub-banding efficace   *}
{*                                                                         *}
{*        Reste à retirer la limite de 64(up)+64(down) profils simultanés  *}
{*        ( Astuce : Calculer la taille des tables de tracé en fin de      *}
{*                   parcours.. )                                          *}
{*                                                                         *}
{***************************************************************************}

Unit RASTER;

interface

{$DEFINE DEBUG}    (* Affiche par writeln les erreurs fatales du raster *)

{ $DEFINE DEBUG2}  (* Trace le bloc inverse en fin de render *)
{ $DEFINE DEBUG3}  (* Trace les pixels pendant le render *)
{ $DEFINE DEBUG4}  (* Trace les profils plutôt que les pleins *)

{$DEFINE REVERSE} (* Autorise l'affichage des glyphes dont l'orientation *)
                  (* est erronnée                                        *)

{ $DEFINE CALCUL}

uses TTTypes,
     TTCalc,
     TTDisp;   (* This one only for debugging purpose *)

const
  TTFlowDown  = -1; (* Indique un bitmap orienté de haut en bas *)
  TTFlowUp    =  1; (* Indique un bitmap orienté de bas en haut *)
  TTFlowError =  0; (* Indique une erreur lors du calcul        *)

  Err_Ras_None       =  0;
  Err_Ras_NotIni     = -2;  { Rasterizer not Initialized   }
  Err_Ras_Overflow   = -3;  { Profile Table Overflow       }
  Err_Ras_Neg_H      = -4;  { Negativ Height encountered ! }
  Err_Ras_Invalid    = -5;  { Invalid value encountered !  }

  TTDropOutControlNone     = 0;  { No Drop-out control                 }
  TTDropOutControlSimple   = 1;  { Simple Drop-out control ( rule #3 ) }
  TTDropOutControlComplex  = 2;  { Sophisticated control ( rule #4 )   }

type

  (* Cette structure permet de décrire le type du BitMap où seront  *)
  (* rendus les glyphes                                             *)

  PRasterBlock = ^TRasterBlock;
  TRasterBlock = record
                   Rows   : ULong;        (* Nombre de lignes du bloc    *)
                   Cols   : ULong;        (* Nombre de colonnes du bloc  *)
                   Width  : ULong;        (* Nombre de pixels/ligne      *)
                   Flow   : LongInt;      (* Définit l'orientation du    *)
                                          (* bitmap                      *)
                   Buffer : Pointer;      (* Pointeur vers le Buffer     *)
                   Size   : ULong;        (* Taille du buffer            *)
                 end;


  (* Cette structure permet de décrire au rasterizer le glyphe que nous  *)
  (* voulons rendre dans le BitMap                                       *)

  PGlyphRecord = ^TGlyphRecord;
  TGlyphRecord = record
                   Outlines  : ULong;      (* Nombre de contours du glyphe *)
                   OutStarts : Pointer;    (* Indices de début de chaque   *)
                                           (* contour                      *)
                   Points    : ULong;      (* Nombre de points             *)
                   XCoord    : Pointer;    (* Tableau des abscisses        *)
                   YCoord    : Pointer;    (* Tableau des ordonnées        *)
                   Flag      : Pointer;    (* Tableau des flags            *)
                  end;

var
  Rast_Err : Int;

function InitRasterizer( var rasterBlock : TRasterBlock;
                             profBuffer  : PStorage;
                             profSize    : ULong
                        )
                        : Int;

function RenderGlyph( var AGlyph : TGlyphRecord;
                          xmax,
                          ymax   : Int
                    ) : boolean;

implementation


const
  MaxBezier  = 32;       (* Le nombre maximum de sous-arcs de Bezier *)
  MaxProfils = 256;      (* Le nombre maximum de profils d'un glyphe *)

  Precision  = 64;               (* Precision sur 6 bits         *)
  Precision2 = Precision div 2;  (* La moitié de notre précision *)


type

  TEtats  = ( Indetermine, Ascendant, Descendant, Plat, Rupture );

  PTraceRec = ^TTraceRec;

  PProfil = ^TProfil;
  TProfil = record
              Flow   : Int;       (* Profil montant ou descendant  *)
              Height : Int;       (* Hauteur du profil             *)
              Start  : Int;       (* ordonnée de départ du profil  *)
              Offset : ULong;     (* Offset de début du profil     *)

              Link   : PProfil;   (* Prochain profil de la liste   *)
              Index  : Int;       (* Index dans le teableau de     *)
                                  (* tracé                         *)
              CountL : Int;       (* Nombre de lignes à compléter  *)
                                  (* avant le début du tracé de    *)
                                  (* ce profil                     *)
              StartL : Int;       (* Première ligne du tracé       *)
              Trace  : PTraceRec; (* Pointeur sur le tracé utilisé *)
            end;


  TBand = record
            Y_Min : Int;
            Y_Max : Int;
          end;

  TTraceElement = record
                   Profil : PProfil;   (* Profil de cette abscisse       *)
                   X      : LongInt;   (* Abscisse sur la ligne courante *)
                  end;

  PTraceArray = ^TTraceArray;
  TTraceArray = Array[0..127] of TTraceElement;

  TTraceRec = record
               N : Int;
               T : PTraceArray;
              end;


const
  AlignProfileSize = ( sizeOf(TProfil) + 3 ) div 4;
  AlignTraceSize   = ( sizeOf(TTraceRec) + 3 ) div 4;

var
  cProfil  : PProfil;    (* Profil Courant *)
  fProfil  : PProfil;    (* Tête de la liste chaînée des profils *)
  oProfil  : PProfil;    (* Old Profile                          *)
  gProfil  : PProfil;    (* Last Profile in case of impact       *)

  nProfs   : Int;        (* Nombre courant de profils *)

  Etat     : TEtats;       (* Etat du trace *)

  Fresh    : Boolean;      (* Indique un profil neuf dont le champ 'START' *)
                           (* doit être complété                           *)

  Joint    : Boolean;      (* Indique que le dernier arc est tombé pile
                              sur une scanLine. Evite les doublons *)

  Buff     : PStorage;     (* Buffer Profils              *)
  MaxBuff  : ULong;        (* Taille du buffer            *)
  profCur  : ULong;        (* Curseur du Buffer Profils   *)

  Cible      : TRasterBlock; (* Description du Bitmap cible *)

  BCible     : PByteArray;   (* Buffer bitmap cible *)

  Band_Stack : array[1..16] of TBand;
  Band_Top   : Int;

  Trace_Left,
  Trace_Right : TTraceRec;

  TraceOfs : Int;      (* Offset courant du tracé dans le bitmap  *)
  DebugOfs : Int;      (* Offset écrant pour le débogage du tracé *)

  Arcs     : Array[0..2*MaxBezier] of
              record                   (* La pile de points qui permet  *)
               X, Y : LongInt          (* de travailler sur les arcs de *)
              end;                     (* Bézier                        *)

  CurArc   : Int;                      (* Taille de la pile             *)

  XCoord,
  YCoord   : PStorage;

  Flags    : PByteArray;
  Outs     : PShortArray;

  nPoints,
  nContours : Int;

  LastX,
  LastY,
  MinY,
  MaxY     : LongInt;

  DropOutControl : Byte;

{************************************************}
{*                                              *}
{* Pset :                                       *}
{*                                              *}
{*  Cette procédure sert au débogage            *}
{*                                              *}
{************************************************}

procedure PSet;
var c : byte;
    o : Int;
    x : LongInt;
begin
  X := Buff^[profCur];

  with cProfil^ do
   begin
    case Flow of
      TTFlowUp   : o := 80*(profCur-Offset+Start) + ( X div (Precision*8) );
      TTFlowDown : o := 80*(Start-profCur+offset) + ( X div (Precision*8) );
     end;
    if o>0 then
     begin
      c := Vio^[o] or ( $80 shr ( (X div precision) and 7 ));
      Vio^[o]:=c;
     end
   end;

end;

{$IFDEF DEBUG3}
procedure ClearBand( y1, y2 : Int );
var
  Y : Int;
  K : Word;
begin
  K := y1*80;
  FillChar( Vio^[k], (y2-y1+1)*80, 0 );
end;
{$ENDIF}

{************************************************}
{*                                              *}
{* InitProfile :                                *}
{*                                              *}
{*                                              *}
{*                                              *}
{*                                              *}
{************************************************}

procedure InitProfile;
begin
  cProfil         := PProfil( @Buff^[profCur] );
  cProfil^.Offset := profCur;
  nProfs          := 0;
end;

{************************************************}
{*                                              *}
{* NewProfile :                                 *}
{*                                              *}
{*  Crée un nouveau profil                      *}
{*                                              *}
{************************************************}

function NewProfile( AEtat : TEtats ) : boolean;
begin

  if fProfil = NIL then
    begin
      cProfil := PProfil( @Buff^[profCur] );
      fProfil := cProfil;
      inc( profCur, AlignProfileSize );
    end;

  if profCur >= MaxBuff then
    begin
      Rast_Err   := Err_Ras_Overflow;
      NewProfile := False;
      exit;
    end;

  with cProfil^ do
    begin

      Case AEtat of

        Ascendant  : Flow := TTFlowUp;
        Descendant : Flow := TTFlowDown;
      else
{$IFDEF DEBUG}
        Writeln('ERREUR : Profil incohérent' );
        Halt(30);
{$ELSE}
        NewProfile := False;
        Rast_Err   := Err_Ras_Invalid;
        exit;
{$ENDIF}
      end;

      Start  := 0;
      Height := 0;
      Offset := profCur;
      Link   := nil;
    end;

  if gProfil = nil then gProfil := cProfil;

  Etat  := AEtat;
  Fresh := True;
  Joint := False;

  NewProfile := True;
end;


{************************************************}
{*                                              *}
{* EndProfile :                                 *}
{*                                              *}
{*  Finalise le profil actuel                   *}
{*                                              *}
{************************************************}

function EndProfile : boolean;
var
  H : Int;
begin
  H := profCur - cProfil^.Offset;

  if H < 0 then
    begin
      EndProfile := False;
      Rast_Err   := Err_Ras_Neg_H;
      exit;
    end;

  if H > 0 then
    begin
      cProfil^.Height := H;
      cProfil         := PProfil( @Buff^[profCur] );

      inc( profCur, AlignProfileSize );
      cProfil^.Height := 0;
      cProfil^.Offset := profCur;
      inc( nProfs );
    end;

  if profCur >= MaxBuff then
    begin
      EndProfile := False;
      Rast_Err   := Err_Ras_Overflow;
      exit;
    end;

  Joint := False;

  EndProfile := True;
end;

{************************************************}
{*                                              *}
{* FinalizeProfileTable :                       *}
{*                                              *}
{*  Ajuste les liens de la table des profils    *}
{*                                              *}
{************************************************}

procedure FinalizeProfileTable;
var
  n : int;
  p : PProfil;
begin
  n := nProfs;

  if n > 1 then
    begin

      P := fProfil;

      while n > 1 do with P^ do
        begin
          Link := PProfil( @Buff^[ Offset + Height ] );
          P    := Link;

          dec( n );
        end;

      P^.Link := nil;

    end
  else
    fProfil := nil;

end;

{************************************************}
{*                                              *}
{* SplitBezier :                                *}
{*                                              *}
{*   Decompose un arc de Bezier en deux sous-   *}
{*   arcs dans la pile.                         *}
{*                                              *}
{************************************************}

procedure SplitBezier;
var
  X1, Y1, X2, Y2 : LongInt;
begin
  with Arcs[CurArc+2] do begin x1:=x; y1:=y; end;
  with Arcs[CurArc]   do begin x2:=x; y2:=y; end;

  with Arcs[CurArc+4] do begin x:=x1; y:=y1; end;
  with Arcs[CurArc+1] do
   begin
    inc(x1,x); inc(y1,y);
    inc(x2,x); inc(y2,y);
   end;

  x1 := x1 div 2; x2 := x2 div 2;
  y1 := y1 div 2; y2 := y2 div 2;

  with Arcs[CurArc+3] do begin x:=x1; y:=y1; end;
  with Arcs[CurArc+1] do begin x:=x2; y:=y2; end;
  with Arcs[CurArc+2] do
   begin
    x:=( x1+x2 ) div 2;
    y:=( y1+y2 ) div 2;
   end;

  Inc( CurArc,2);
end;



{************************************************}
{*                                              *}
{* PushBezier :                                 *}
{*                                              *}
{*   Empile un arc de Bezier au sommet de la    *}
{*   pile.                                      *}
{*                                              *}
{************************************************}

procedure PushBezier( x1, y1, x2, y2, x3, y3 : LongInt );
begin
  curArc:=0;

  with Arcs[CurArc+2] do begin x:=x1; y:=y1; end;
  with Arcs[CurArc+1] do begin x:=x2; y:=y2; end;
  with Arcs[ CurArc ] do begin x:=x3; y:=y3; end;
end;




{************************************************}
{*                                              *}
{* LineUp                                       *}
{*                                              *}
{*  Détermine les abscisses d'un segment        *}
{*  ascendant et les stocke dans le buffer de   *}
{*  profils.                                    *}
{*                                              *}
{************************************************}


function LineUp( x1, y1, x2, y2 : LongInt ) : boolean;
var
  Dx, Dy               : LongInt;
  e1, e2, f1, f2, size : Int;
  Ix, Rx, Ax           : LongInt;
begin
  LineUp := True;

  Dx:=x2-x1; Dy:=y2-y1;

  if (Dy<=0) or (y2<MinY) or (y1>MaxY) then exit;

  if y1 < MinY then
   begin
    x1 := x1 + MulDiv( Dx, MinY-y1, Dy );
    e1 := MinY div Precision;
    f1 := 0;
   end
  else
   begin
    e1:= y1 div Precision;
    f1:= y1 mod Precision;
   end;

  if y2>MaxY then
   begin
    x2 := x2 + MulDiv( Dx, MaxY-y2, Dy );
    e2 := MaxY div Precision;
    f2 := 0;
   end
  else
   begin
    e2 := y2 div Precision;
    f2 := y2 mod Precision;
   end;

  if f1>0 then
   if e1=e2 then exit
    else
     begin
      x1 := x1 + MulDiv( Dx, Precision-f1, Dy );
      e1 := e1 + 1;
     end

  (* Ce test permet d'éliminer les doublons *)

  else
   if Joint then begin dec( profCur ); Joint:=False; end;


  if f2>0 then x2 := x2 + MulDiv( Dx, -f2, Dy )
  else
    Joint:=True;

  (* Indique qu'on est tombé pile sur une ScanLine, pour éviter *)
  (* les doublons                                               *)

  (* On vérifie si le profil est neuf *)

  if Fresh then
   begin
    cProfil^.Start:=e1;
    Fresh:=False;
   end;

  (* Bon, on y va *)

  if Dx>0 then
   begin

    Ix := (Precision*Dx) div Dy;
    Rx := (Precision*Dx) mod Dy;
    Ax := 0;
    Dx := 1;
   end
  else
   begin
    Ix := -((Precision*-Dx) div Dy);
    Rx := (Precision*-Dx) mod Dy;
    Ax := 0;
    Dx:=-1;
   end;

  size := ( e2-e1 )+1;
  if ( profCur + size >= MaxBuff ) then
   begin
     LineUp   := False;
     Rast_Err := Err_Ras_Overflow;
     exit;
   end;

  Repeat

    Buff^[profCur] := x1;
    {$IFDEF DEBUG3} Pset; {$ENDIF}
    inc( profCur );


    x1:=x1+Ix;
    Ax:=Ax+Rx;
    if Ax>=Dy then begin Ax:=Ax-Dy; Inc(x1, Dx ); end;
    inc( e1 );

  Until e1>e2;
end;



{************************************************}
{*                                              *}
{* LineDown                                     *}
{*                                              *}
{*  Détermine les abscisses d'un segment        *}
{*  descendant et les store dans le buffer de   *}
{*  profils.                                    *}
{*                                              *}
{************************************************}


function LineDown( x1, y1, x2, y2 : LongInt ): boolean;
var
  Dx, Dy                : LongInt;
  e1, e2, f1, f2, size  : Int;

  Ix, Rx, Ax            : LongInt;
begin
  LineDown := True;

  Dx:=x2-x1; Dy:=y2-y1;

  if (Dy>=0) or (y1<MinY) or (y2>MaxY) then exit;

  if y1>MaxY then
   begin
    x1 := x1 + MulDiv( Dx, MaxY-y1, Dy );
    e1 := MaxY div Precision;
    f1 := 0;
   end
  else
   begin
    e1:= y1 div Precision;
    f1:= y1 mod Precision;
   end;

  if y2<MinY then
   begin
    x2 := x2 + MulDiv( Dx, MinY-y2, Dy );
    e2 := MinY div Precision;
    f2 := 0;
   end
  else
   begin
    e2 := y2 div Precision;
    f2 := y2 mod Precision;
   end;

  if f1>0 then x1 := x1 + MulDiv( Dx, -f1, Dy )
  else

  (* Ce test permet d'éviter des doublons *)

  if Joint then begin dec( profCur ); Joint:=False; end;


  if f2>0 then
   if e2=e1 then exit
    else
     begin
      x2 := x2 + MulDiv( Dx, Precision-f2, Dy );
      e2 := e2 + 1;
     end
    else
     Joint:=True;

  (* Indique qu'on est tombé pile sur une ScanLine, pour éviter *)
  (* les doublons                                               *)

  (* On vérifie si le profil est neuf *)

  If Fresh then
   begin
    cProfil^.Start:=e1;
    Fresh:=False;
   end;

  (* Bon, on y va *)

  if Dx<0 then
   begin
    Ix := -((Precision*-Dx) div -Dy);
    Rx := (Precision*-Dx) mod -Dy;
    Ax := 0;
    Dx := -1;
   end
  else
   begin
    Ix := (Precision*Dx) div -Dy;
    Rx :=   (Precision*Dx) mod -Dy;
    Ax := 0;
    Dx := 1;
   end;

  Dy:=-Dy;

  size := ( e1-e2 )+1;
  if ( profCur + size >= MaxBuff ) then
   begin
     LineDown := False;
     Rast_Err := Err_Ras_Overflow;
     exit;
   end;

  Repeat

    Buff^[profCur] := x1;
    {$IFDEF DEBUG3} Pset; {$ENDIF}
    inc( profCur );

    x1:=x1+Ix;
    Ax:=Ax+Rx;
    if Ax>=Dy then begin Ax:=Ax-Dy; Inc(x1, Dx ); end;
    dec( e1 );

  Until e1<e2;
end;


{************************************************}
{*                                              *}
{* BezierUp                                     *}
{*                                              *}
{*  Détermine les abscisses d'un arc de Bézier  *}
{*  ascendant et les stocke dans le buffer de   *}
{*  profils                                     *}
{*                                              *}
{* L'arc considéré est celui qui se trouve au   *}
{* sommet courant de la pile. L'arc est dépilé  *}
{* lorsque la routine rend la main.             *}
{*                                              *}
{************************************************}


function BezierUp : boolean;
var
  x1, y1, x2, y2, e, e2, e0 : LongInt;
  debArc, f1                : Int;

begin
  BezierUp := True;

  y1:=Arcs[curArc+2].y;
  y2:=Arcs[curArc].y;

  if ( y2 < MinY ) or ( y1 > MaxY ) then
   begin
    dec( curArc,2 );
    exit;
   end;

  e2 := Precision*(y2 div Precision);

  if e2 > MaxY then e2 := MaxY;

  e0 := MinY;

  if y1<MinY then e:=MinY
  else
   begin
    e  := Precision*((y1+precision-1) div precision);
    f1 := y1 mod Precision;
    e0 := e;

    if f1=0 then
     begin

      if Joint then begin dec(profCur); Joint:=False; end;
      (* ^ Ce test permet d'éviter les doublons *)

      Buff^[profCur] := Arcs[curArc+2].x;
      {$IFDEF DEBUG3} Pset; {$ENDIF}
      inc( profCur );


      (* Remarque au sujet du débordement de table :     *)
      (*                                                 *)
      (*  Nous savons déjà que profCur < MaxBuff, il     *)
      (*  y a donc la place pour au moins 1 ordonnée     *)
      (*  et nous n'avons pas besoin de faire le test    *)
      (*  ici !                                          *)
      (*                                                 *)

      e:=e+Precision;
     end
   end;

  if Fresh then
   begin
    cProfil^.Start:=e0 div precision;
    Fresh:=False;
   end;

  (* Dépassement de table ? *)
  if ( profCur + (e2 - e) div Precision + 1 >= MaxBuff ) then
    begin
      BezierUp := False;
      Rast_Err := Err_Ras_Overflow;
      exit;
    end;

  debArc := curArc;

  while ( curArc>=debArc ) and ( e<=e2 ) do
   begin
    Joint:=False;

    y2:=Arcs[CurArc].y;

    if y2=e then
     begin
      Joint:=True;

      Buff^[profCur] := Arcs[curArc].x;
      {$IFDEF DEBUG3} Pset; {$ENDIF}
      inc( profCur );

      e:=e+Precision;
      dec( curArc, 2 );
     end

    else
     if y2<e then dec( curArc, 2 )

    else
     begin
      y1:=Arcs[curArc+2].y;

      if (y2-y1)<Precision2 then
       begin
        x1 := Arcs[curArc+2].x;
        x2 := Arcs[curArc].x;

        Buff^[profCur] := x1 + MulDiv( x2-x1, e-y1, y2-y1 );
        {$IFDEF DEBUG3} Pset; {$ENDIF}
        inc( profCur );

        dec( curArc, 2 );
        e:=e+Precision;
       end

      else
       SplitBezier;

     end;
   end;

  curArc:=debArc-2;

end;



{************************************************}
{*                                              *}
{* BezierDown                                   *}
{*                                              *}
{*  Détermine les abscisses d'un arc de Bézier  *}
{*  descendant et les store dans le buffer de   *}
{*  profils                                     *}
{*                                              *}
{* L'arc considéré est celui qui se trouve au   *}
{* sommet courant de la pile. L'arc est dépilé  *}
{* lorsque la routine rend la main.             *}
{*                                              *}
{************************************************}


function BezierDown : boolean;
var
  x1, y1, x2, y2, e, e0, e2 : LongInt;
  f1, debArc                : Int;

begin
  BezierDown := True;

  y1:=Arcs[curArc+2].y;
  y2:=Arcs[curArc].y;

  if ( y1 < MinY ) or ( y2 > MaxY ) then
   begin
    dec( curArc,2 );
    exit;
   end;

  e2 := Precision*( (y2+Precision-1) div Precision );

  if e2 < MinY then e2 := MinY;

  e0 := MaxY;

  if y1 > MaxY then e := MaxY
  else
   begin
    e  := Precision*(y1 div Precision);
    f1 := y1 mod Precision;
    e0 := e;

    if f1=0 then
     begin
      if Joint then begin dec( profCur ); Joint:=False; end;
      (* ^ Ce test permet d'éviter les doublons *)

      Buff^[profCur] := Arcs[curArc+2].x;
      {$IFDEF DEBUG3} Pset; {$ENDIF}
      inc( profCur );


      (* Remarque au sujet du débordement de table :     *)
      (*                                                 *)
      (*  Nous savons déjà que profCur < MaxBuff, il     *)
      (*  y a donc la place pour au moins 1 ordonnée     *)
      (*  et nous n'avons pas besoin de faire le test    *)
      (*  ici !                                          *)
      (*                                                 *)

      e := e-Precision;
     end
   end;

  if Fresh then
   begin
    cProfil^.Start:=e0 div Precision;
    Fresh:=False;
   end;

  if ( profCur + (e - e2) div Precision + 1 >= MaxBuff ) then
    begin
      Rast_Err   := Err_Ras_Overflow;
      BezierDown := False;
      exit;
    end;

  debArc := curArc;

  while ( curArc>=debArc ) and ( e>=e2 ) do
   begin
    Joint:=False;

    y2:=Arcs[CurArc].y;

    if y2=e then
     begin
      Joint:=True;

      Buff^[profCur] := Arcs[curArc].x;
      {$IFDEF DEBUG3} Pset; {$ENDIF}
      inc( profCur );

      e:=e-Precision;
      dec( curArc,2 );
     end

    else
     if y2>e then dec( curArc,2 )

    else
     begin
      y1:=Arcs[curArc+2].y;

      if (y1-y2)<Precision2 then
       begin
        x1 := Arcs[curArc+2].x;
        x2 := Arcs[curArc].x;

        Buff^[profCur] := x1 + MulDiv( x2-x1, e-y1, y2-y1 );
        {$IFDEF DEBUG3} Pset; {$ENDIF}
        inc( profCur );

        dec( curArc,2 );
        e:=e-Precision;
       end

      else
       SplitBezier;

     end;
   end;

 curArc:=debArc-2;

end;



{************************************************}
{*                                              *}
{* LineTo                                       *}
{*                                              *}
{*  Injection d'une ligne lors du calcul des    *}
{*  abscisses/ordonnées                         *}
{*                                              *}
{************************************************}

function LineTo( x, y : LongInt ) : boolean;
begin
  LineTo := False;

  case Etat of

    Indetermine : if y>lastY then
                    if not NewProfile( Ascendant ) then exit else
                  else
                   if y<lastY then
                    if not NewProfile( Descendant ) then exit;

    Ascendant   : if y<lastY then
                   begin
                    if not EndProfile or
                       not NewProfile( Descendant ) then exit;
                   end;

    Descendant  : if y>LastY then
                   begin
                    if not EndProfile or
                       not NewProfile( Ascendant ) then exit;
                   end;
   end;

  Case Etat of
    Ascendant  : if not LineUp  ( LastX, LastY, X, Y ) then exit;
    Descendant : if not LineDown( LastX, LastY, X, Y ) then exit;
   end;

  LastX:=x;
  LastY:=y;

  LineTo := True;
end;



{************************************************}
{*                                              *}
{* BezierTo                                     *}
{*                                              *}
{*  Injection d'un arc de Bézier lors du calcul *}
{*  des abscisses/ordonnées                     *}
{*                                              *}
{************************************************}

function BezierTo( x, y, Cx, Cy : LongInt ) : boolean;
var
  y1, y2, y3, x3 : LongInt;
  Etat_Bez       : TEtats;
begin
  BezierTo := False;

  PushBezier( LastX, LastY, Cx, Cy, X, Y );

  while ( curArc>=0 ) do
   begin
    y1:=Arcs[curArc+2].y;
    y2:=Arcs[curArc+1].y;
    y3:=Arcs[curArc].y;
    x3:=Arcs[curArc].x;

    {* On détermine l'état du bézier courant *}

    if y1 = y2 then
     begin

      if y2 = y3 then Etat_Bez := Plat
      else
      if y2 > y3 then Etat_Bez := Descendant
      else
                      Etat_Bez := Ascendant;
     end

    else
    if y1 > y2 then
     begin

      if y2 >= y3 then Etat_Bez := Descendant
      else
                       Etat_Bez := Indetermine;
     end

    else
     begin

      if y2 <= y3 then Etat_Bez := Ascendant
      else
                       Etat_Bez := Indetermine;
     end;


    {* On agit en conséquence *}

    case Etat_Bez of

      Plat        : dec( curArc, 2 );

      Indetermine : SplitBezier;

    else

      if Etat <> Etat_Bez then
        begin

          if Etat <> Indetermine then
            if not EndProfile then exit;

          if not NewProfile( Etat_Bez ) then exit;

        end;

      case Etat of

        Ascendant  : if not BezierUp then exit;
        Descendant : if not BezierDown then exit;

      end;

    end;
   end;

  LastX:=x3;
  LastY:=y3;

  BezierTo := True;
end;



{************************************************}
{*                                              *}
{* CurveTo                                      *}
{*                                              *}
{*   Injection de plusieurs arcs de Béziers     *}
{*                                              *}
{************************************************}

function CurveTo( x, y : LongInt; FirstCtrl, LastCtrl : Int ) : boolean;
var
  NextCtrl       : Int;
  xz, yz, cx, cy : LongInt;
begin

  CurveTo := False;

  NextCtrl := FirstCtrl+1;

  xz := XCoord^[FirstCtrl];
  yz := YCoord^[FirstCtrl];

  while FirstCtrl <= LastCtrl do
   begin

    if NextCtrl <= LastCtrl then
     begin
      cx := ( xz + XCoord^[NextCtrl] ) div 2;
      cy := ( yz + YCoord^[NextCtrl] ) div 2;
     end

    else
     begin
      cx := x;
      cy := y;
     end;

    if not BezierTo( cx, cy, xz, yz ) then exit;

    xz := XCoord^[NextCtrl];
    yz := YCoord^[NextCtrl];

    inc( FirstCtrl );
    inc( NextCtrl  );
   end;

  CurveTo := True;

end;


{************************************************}
{*                                              *}
{* ConvertGlyph                                 *}
{*                                              *}
{*  Effectue la conversion d'un glyphe en un    *}
{*  ensemble de profils.                        *}
{*                                              *}
{************************************************}

Function ConvertGlyph( _xCoord, _yCoord : PStorage ) : boolean;
var
  i, j, First, Last, Start : Int;

  y1, y2, y3 :  LongInt;

begin
  ConvertGlyph := False;

  j       := 0;
  nProfs  := 0;
  fProfil := NIL;
  Joint   := False;
  Fresh   := False;

  XCoord := _XCoord;
  YCoord := _YCoord;

  InitProfile;

  for i:=0 to nContours-1 do
   begin

    Etat    := Indetermine;
    First   := j;
    LastX   := xCoord^[j];
    LastY   := yCoord^[j];
    Start   := 0;
    gProfil := nil;

    inc(j);

    while j <= Outs^[i] do
     begin

      if Flags^[j] and 1 = 0 then  (* OFF Curve *)

        if Start=0 then
          begin
           Start := j;
           Last  := j;
          end
         else
          inc( Last )

      else                     (* ON Curve *)
       if Start<>0 then
        begin
         if not CurveTo( XCoord^[j], YCoord^[j], Start, Last ) then exit;
         Start:=0;
        end
       else
         if not LineTo( XCoord^[j], YCoord^[j] ) then exit;

      inc(j);
     end;

    if Start<>0 then
      if not CurveTo( XCoord^[First], YCoord^[First], Start, Last )
          then exit else
     else
      if not LineTo( XCoord^[First], YCoord^[First] ) then exit;


    (* Nous devons maintenant vérifier que les deux arcs extrémités ne se *)
    (* rejoignent pas.                                                    *)

    if ( lastY and (Precision-1) = 0 ) and
       ( lastY >= MinY ) and
       ( lastY <= MaxY ) then

      if ( gProfil <> nil ) and                  (* gProfil can be nil    *)
         ( gProfil^.Flow = cProfil^.Flow ) then  (* if the contour was    *)
                                                 (* too small to be drawn *)
           dec( profCur );

    if not EndProfile then exit;
   end;

  FinalizeProfileTable;

  ConvertGlyph := True;
end;


{************************************************}
{*                                              *}
{* RenderGlyph                                  *}
{*                                              *}
{*  cette fonction est temporaire, elle         *}
{*  permet surtout de tester et debugger l'unité*}
{*                                              *}
{*                                              *}
{************************************************}

  procedure Pixel( x,y : Int );
  var c : byte;
      o : int;
  begin
    if (x<0) or (x>=Cible.Width) or
       (y<0) or (y>=Cible.Rows) then exit;

    o := Cible.Cols*y + (x shr 3);
    c := PByteArray( Cible.Buffer )^[o];
    c := c or ( $80 shr (x and 7) );

  {$IFDEF DEBUG2}
    Vio^[ 80*y + (x shr 3) ]:=c;
  {$ENDIF}

    PByteArray(Cible.Buffer)^[o]:=c;
  end;


  procedure InsNew( Traces : PTraceRec;
                    Profil : PProfil;
                    X      : LongInt
                  );
  var
    I, J : Int;
  begin
    I:=0;
    with Traces^ do
     begin
       while ( I < N ) and ( T^[i].X <= X ) do inc(i);
       if i<N then
         for j:=N-1 downto i do
           begin
             T^[j+1]               := T^[j];
             T^[j+1].Profil^.Index := j+1;
           end;
       T^[i].Profil  := Profil;
       T^[i].X       := X;
       Profil^.Index := i;

       inc( N );
     end
  end;


  procedure DelOld( Traces : PTraceRec;
                    Index  : Int
                  );
  var
    I : Int;
  begin
    with Traces^ do
     begin
       T^[Index].Profil^.Index:=-1;

       for I:=Index to N-2 do
        begin
         T^[i]               := T^[i+1];
         T^[i].Profil^.Index := i;
        end;
       dec( N );
     end
  end;


  procedure Sort0( var Trace : TTraceRec );
  var
    I, J : Int;
    K    : LongInt;
    Q    : PProfil;
  begin
   with Trace do

    for I:=1 to N-1 do

     for J:=I downto 1 do

      if T^[j].X < T^[j-1].X then
       begin

        k         := T^[j-1].x;
        T^[j-1].x := T^[ j ].x;
        T^[ j ].x := k;

        Q              := T^[j-1].Profil;
        T^[j-1].Profil := T^[ j ].Profil;
        T^[ j ].Profil := Q;

        T^[j-1].Profil^.Index := j-1;
        Q^.Index              := j;

       end;
  end;

  procedure Sort( var Trace : TTraceRec );
  var
    I, J : Int;
    K, L : LongInt;
    Q    : PProfil;
  begin

   K := Trace.T^[0].X;

   with Trace do

    for I:=1 to N-1 do

    begin

     L := T^[i].X;

     if K > L then

       begin

         for I:=1 to N-1 do
          for J:=I downto 1 do

           if T^[j].X < T^[j-1].X then
            begin

             k         := T^[j-1].x;
             T^[j-1].x := T^[ j ].x;
             T^[ j ].x := k;

             Q              := T^[j-1].Profil;
             T^[j-1].Profil := T^[ j ].Profil;
             T^[ j ].Profil := Q;

             T^[j-1].Profil^.Index := j-1;
             Q^.Index              := j;

            end;
         exit;
       end
     else
       K := L;
    end
  end;


function DrawGlyph : boolean;

const
  LMask : array[0..7] of Byte
        = ($FF,$7F,$3F,$1F,$0F,$07,$03,$01);

  RMask : array[0..7] of Byte
        = ($80,$C0,$E0,$F0,$F8,$FC,$FE,$FF);
label
  No_Draw;

var
  y, k,
  I, J   : Int;
  P, Q   : PProfil;

  min_Y,
  max_Y  : Int;

  e1, e2,
  x1, x2 : LongInt;

  c1, c2 : Int;
  f1, f2 : Int;

begin

  DrawGlyph := False;

  {* On repère d'abord le minimum et le maximum des Y *}

  P     := fprofil;
  max_Y := MinY div Precision;
  min_Y := MaxY div Precision;

  while P<>NIL do
   with P^ do
    begin
     Case Flow of

       TTFlowUp : begin
                   if min_Y > Start          then min_Y := Start;
                   if max_Y < Start+Height-1 then max_Y := Start+height-1;

                   StartL := Start;
                   Index  := -1;
                   Trace  := @Trace_Left;
                  end;

       TTFlowDown : begin
                     if min_Y > Start-Height+1 then min_Y := Start-Height+1;
                     if max_Y < Start          then max_Y := Start;

                     StartL := Start-Height+1;
                     Offset := Offset+Height-1;
                     Index  := -1;
                     Trace  := @Trace_Right;
                    end;
      else
        (* Severe Error here !! *)
        Rast_Err := Err_Ras_Invalid;
        exit;
      end;

     P := Link;
   end;

  {* On calcule la distance au minimum de chaque profil *}

  P := fProfil;

  while P<>NIL do
   with P^ do
    begin
     CountL := (StartL-min_Y)+1;
     P      := Link;
    end;

  {* On se prépare encore un peu avant le grand saut *}

  TraceOfs := Cible.Cols * min_Y;

  Trace_Right.N := 0;
  Trace_Left.N  := 0;

  {* On y va *}

  for y := min_Y to max_Y do
   begin

    P := fProfil;

    while P<>NIL do
     with P^ do

     begin

      if CountL > 0 then
       begin
         dec( CountL );
         if CountL = 0 then
          begin
           InsNew( Trace, P, Buff^[Offset] );
           inc( Offset, Flow );
           dec( Height );
          end
       end

      else
       if CountL = 0 then
        begin
         Trace^.T^[Index].X := Buff^[Offset];
         inc( Offset, Flow );
         dec( Height );
        end;

      P:=Link;
     end;

    {* Maintenant, on trie *}

    Sort( Trace_Left );
    Sort( Trace_Right );

    {* Puis on trace *}

    i := 0;

    while ( i < Trace_Left.N ) do
     begin

      x1 := Trace_Left.T ^[i].X;
      x2 := Trace_Right.T^[i].X;

{$IFDEF REVERSE}
      if x1 > x2 then
        begin
          e1 := x1;
          x1 := x2;
          x2 := e1;
        end;
{$ENDIF}

      e1 := ( x1+63 ) and -64;
      e2 := x2 and -64;

      (* Drop-out control *)

      if e1 > e2 then
       if e1 = e2+1 then
        case DropOutControl of

          0 : goto No_Draw;


          (* Drop-out Control Rule #3 *)
          1 : e2 := e1;

          (* Drop-out Control Rule #4 *)
          2 : begin
               P := Trace_Left.T ^[i].Profil;
               Q := Trace_Right.T^[i].Profil;

               if ( P^.Height <= 0 ) or ( Q^.Height <= 0 )
                 then goto No_Draw;

               if ( y<=P^.StartL ) or ( y<=Q^.StartL )
                 then goto No_Draw;

               e2:=e1;
              end;
        end
       else
        goto No_Draw;

      e1 := e1 div Precision;
      e2 := e2 div Precision;

      if ( e2 >= 0 ) and ( e1 < Cible.Width ) then
        begin

          if e1 <  0 then e1 := 0;
          if e2 >= Cible.Width then e2 := Cible.Width-1;

          c1 := e1 shr 3;
          c2 := e2 shr 3;

          f1 := e1 and 7;
          f2 := e2 and 7;

          j := TraceOfs + c1;

          if c1 = c2 then
            BCible^[j] := BCible^[j] or ( LMask[f1] and Rmask[f2] )
          else
           begin
             BCible^[j] := BCible^[j] or LMask[f1];

             if c2>c1+1 then
               FillChar( BCible^[j+1], c2-c1-1, $FF );

             inc( j, c2-c1 );

             BCible^[j] := BCible^[j] or RMask[f2];

           end
        end;

     No_Draw:

       inc(i);

     end;


    {* Et enfin, on finalise les tracés *}

    inc( TraceOfs, Cible.Cols );
    inc( DebugOfs, 80 );

    P := fProfil;

    while P<>NIL do
     with P^ do
      begin

       if (CountL=0) and (Height=0) then
        begin
         DelOld( Trace, P^.Index );
         Height:=-1;
         CountL:=-1;
        end;

       P := Link;
      end;
   end;

  DrawGlyph := True;

end;



function RenderGlyph( var AGlyph      : TGlyphRecord;
                          xmax,
                          ymax        : Int ) : boolean;
var
  i, j, k : Int;
  P       : PProfil;
  profIni : Int;
begin

 RenderGlyph := False;

 if Buff = nil then
   begin
     Rast_Err := Err_Ras_NotIni;
     exit;
   end;

 Outs     := AGlyph.OutStarts;
 Flags    := Aglyph.Flag;
 nPoints  := AGlyph.Points;
 nContours:= AGlyph.Outlines;

 Rast_Err := Err_Ras_None;

 I := 64 * sizeof(TTraceRec);

 profCur:= ( 2*I + 3 ) div 4;

 Trace_Left.T  := PTraceArray( Buff );
 Trace_Right.T := PTraceArray( @Buff^[(I+3) div 4] );

 profIni := profCur;

 Band_Top            := 1;
 Band_Stack[1].Y_Min := 0;
 Band_Stack[1].Y_Max := Cible.Rows-1;

 BCible := PByteArray( Cible.Buffer );

 while Band_Top > 0 do

   begin

     with Band_Stack[ Band_Top ] do
       begin
         MaxY   := Y_Max * Precision;
         MinY   := Y_Min * Precision;
       end;

     profCur  := profIni;
     Rast_Err := Err_Ras_None;

     if not ConvertGlyph( AGlyph.XCoord, AGlyph.YCoord ) then
       begin

         (* sub-banding *)

         {$IFDEF DEBUG3}
         ClearBand( MinY div Precision, MaxY div Precision );
         {$ENDIF}

         with Band_Stack[Band_Top] do
           begin
             I := Y_Min;
             J := Y_Max;
           end;

         K := ( I + J ) div 2;

         if ( Band_Top >= 8 ) or ( K <= I ) then
           begin
             Band_Top := 0;
             Rast_Err := Err_Ras_Invalid;
             exit;
           end
         else
           begin

             with Band_Stack[Band_Top+1] do
               begin
                 Y_Min := K;
                 Y_Max := J;
               end;

             Band_Stack[Band_Top].Y_Max := K-1;

             inc( Band_Top );
           end
       end
     else
       begin
         if ( fProfil <> nil ) then
         {$IFDEF CALCUL}
           begin end;
         {$ELSE}
           if not DrawGlyph then exit;
         {$ENDIF}
         dec( Band_Top );
       end;

   end;

 RenderGlyph := True;
 exit;

{$IFNDEF DEBUG4}
 DrawGlyph;

{$ELSE}
 P:=fProfil;
 while P<>NIL do
  begin
   with P^ do
    case Flow of

      TTFlowUp   : for j:=0 to Height-1 do
                    Pixel( ( Buff^[Offset+j]+Precision-1 ) div Precision,
                           Start+j );

      TTFlowDown : for j:=0 to Height-1 do
                    Pixel( Buff^[Offset+j] div Precision,
                           Start-j );
    end;
   P:=P^.Link;
  end;
{$ENDIF}

end;


{************************************************}
{*                                              *}
{* InitRasterizer                               *}
{*                                              *}
{*  Initialisation du Rasterizer.               *}
{*  Récupère les adresses de la description du  *}
{*  BitMap et du buffer de profils, ainsi que   *}
{*  la taille de ce dernier.                    *}
{*                                              *}
{************************************************}

function InitRasterizer( var rasterBlock : TRasterBlock;
                             profBuffer  : PStorage;
                             profSize    : ULong
                        )
                        : Int;
begin
  Buff    := profBuffer;
  MaxBuff := (profSize div 4) - AlignProfileSize;
  Cible   := rasterBlock;

  DropOutControl := 2;
  Rast_Err       := Err_Ras_None;

  InitRasterizer := 0;
end;


begin
  MaxBuff := 0;
  Buff    := nil;
  profCur := 0;
end.